Language/OS - Multiplatform Resource Library/LANGUAGE OS.iso/simula/books/books.lha/kirkerud/settools.sim

Text File | 1993-08-16 | 20KB | 693 lines

class settools;

begin


!********************************************
!*                        *
!*                 Element                  *
!*                        *
!********************************************;

  class element;
      virtual: text procedure key;
               Boolean procedure precedes, equiv;
               procedure display;
    begin

      text procedure key; key :- notext;

      Boolean procedure precedes(el); ref(element) el;
        precedes := false;

      Boolean procedure equiv(el); ref(element) el;
        equiv := false;

      procedure display; outtext(key);

    end of element;


!********************************************
!*                        *
!*                Sequence                  *
!*                        *
!********************************************;

  element class sequence;

    begin

      ref(element) head_element;
      ref(sequence) tail_sequence;

      Boolean procedure is_empty;
        is_empty := head_element == none;

      integer procedure size;
        size := if head_element == none then 0 else
            if tail_sequence == none then 1
                else 1 + tail_sequence.size;

      ref(element) procedure element_number(elnr); integer elnr;
        element_number :-
            if elnr <= 0 then none else
        if elnr = 1 then head_element else
            if tail_sequence == none then none
            else tail_sequence.element_number(elnr-1);

      procedure append(el); ref(element) el;
        if head_element == none then head_element :- el
        else begin
          if tail_sequence == none then tail_sequence :- new sequence;
          tail_sequence.append(el);
        end;

      procedure display;
        begin ref(element) el;
          outtext("<");
          el :- first_element;
          while el =/= none do
            begin
              el.display; el :- next_element;
              if el =/= none then outtext(", ");
            end;
          outtext(">");
        end;

      ref(sequence) next_sequence, curr_sequence,
                    kept_next_sequence, kept_curr_sequence;

      ref(element) procedure first_element;
        begin
          first_element :- head_element;
          curr_sequence :- this sequence;
          next_sequence :- tail_sequence;
        end;

      ref(element) procedure next_element;
        if next_sequence == none then next_element :- none
        else begin
          next_element  :- next_sequence.head;
          curr_sequence :- next_sequence;
          next_sequence :- next_sequence.tail_sequence;
        end;

      procedure remember_next;
        begin
          kept_next_sequence :- next_sequence;
          kept_curr_sequence :- curr_sequence;
        end;

      procedure restore_next;
        begin
          next_sequence :- kept_next_sequence;
          curr_sequence :- kept_curr_sequence;
        end;

      procedure remove_current;
        if next_sequence =/= none then
          begin
            curr_sequence.head_element  :- next_sequence.head_element;
            curr_sequence.tail_sequence :- next_sequence.tail_sequence;
            next_sequence :- curr_sequence;
          end
        else curr_sequence.head_element :- none;

      procedure remove_head;
        begin
          head_element :- none;
          if tail_sequence =/= none then
            begin
              head_element  :- tail_sequence.head_element;
              tail_sequence :- tail_sequence.tail_sequence;
            end;
        end;

      procedure remove_last;
        if tail_sequence == none then head_element :- none
      else begin
             tail_sequence.remove_last;
             if tail_sequence.is_empty then tail_sequence :- none;
      end;

      ref(element) procedure last_element;
        last_element :- if tail_sequence == none then head_element
            else tail_sequence.last_element;

      ref(element) procedure head;
        head :- head_element;

      ref(sequence) procedure tail;
        tail :- if tail_sequence =/= none then tail_sequence
                else new sequence;

    end of sequence;


!********************************************
!*                        *
!*                Stack                     *
!*                        *
!********************************************;

  element class stack;

    begin

      ref(element) head_element;
      ref(stack)   tail_stack;

      Boolean procedure is_empty;
        is_empty := head_element == none;

      integer procedure size;
        size := if head_element == none then 0 else
            if tail_stack == none then 1
                else 1 + tail_stack.size;

      procedure push(el); ref(element) el;
        if head_element == none then head_element :- el
        else begin
          if tail_stack == none then tail_stack :- new stack;
          tail_stack.push(head_element);
          head_element :- el;
        end;

      ref(element) procedure pop;
        begin
          pop :- head_element;  head_element :- none;
          if tail_stack == none then head_element :- none else
            begin
              head_element :- tail_stack.head_element;
              tail_stack   :- tail_stack.tail_stack;
            end;
        end;

      ref(element) procedure top;
        top :- head_element;

      procedure display;
        begin ref(element) el;
          outtext("<");
          el :- head_element;
          if el =/= none then
            begin
              el.display;
              if tail_stack =/= none then
                tail_stack.display;
            end;
          outtext(">");
        end;

    end of stack;


!********************************************
!*                        *
!*            Ordered_bag                   *
!*                        *
!********************************************;

  element class Ordered_bag;

    begin

      ref(element)     head_element;
      ref(Ordered_bag) tail_bag;

      Boolean procedure is_empty;
        is_empty := head_element == none;

      integer procedure size;
        size := if head_element == none then 0 else
            if tail_bag == none then 1
                else 1 + tail_bag.size;

      procedure add_element(el); ref(element) el;
        if head_element == none
        then head_element :- el
        else begin
          if tail_bag == none then tail_bag :- new Ordered_bag;
          if el.precedes(head_element) then
            begin
              tail_bag.add_element(head_element);
              head_element :- el;
            end
          else if not el.equiv(head_element)
            then tail_bag.add_element(el)
        end;

      procedure display;
        begin ref(element) el;
          outtext("{");
          el :- first_element;
          while el =/= none do
            begin
              el.display; el :- next_element;
              if el =/= none then outtext(", ");
            end;
          outtext("}");
        end;

      ref(ordered_bag) next_bag, curr_bag, kept_next_bag, kept_curr_bag;

      ref(element) procedure first_element;
        begin
          first_element :- head_element;
          curr_bag      :- this Ordered_bag;
          next_bag      :- tail_bag;
        end;

      ref(element) procedure next_element;
        if next_bag == none then next_element :- none
        else begin
          next_element  :- next_bag.head_element;
          curr_bag      :- next_bag;
          next_bag      :- next_bag.tail_bag;
        end;

      procedure set_current;
        remember_next;

      procedure reset_current;
        restore_next;

      procedure remember_next;
        begin
          kept_next_bag :- next_bag;
          kept_curr_bag :- curr_bag;
        end;

      procedure restore_next;
        begin
          next_bag :- kept_next_bag;
          curr_bag :- kept_curr_bag;
        end;

      procedure remove_current;
        if next_bag =/= none then
          begin
            curr_bag.head_element  :- next_bag.head_element;
            curr_bag.tail_bag      :- next_bag.tail_bag;
            next_bag               :- curr_bag;
          end
        else curr_bag.head_element :- none;

      ref(element) procedure last_element;
        last_element :- if tail_bag == none then head_element
            else tail_bag.last_element;

    end of Ordered_bag;


!********************************************
!*                        *
!*                Basis_set                 *
!*                        *
!********************************************;

  element class basis_set;

      virtual: Boolean procedure      is_empty,
                      is_member,
                      add_element_ok,
                      remove_element_ok;
           integer procedure      size;
              procedure           add_element,
                       remove_add_element,
                       remove_element,
                                      set_current,
                                      reset_current,
                       for_each_element;
              ref(element) procedure find_element,
                       first_element,
                      next_element;

    begin

      Boolean procedure add_element_ok(an_element);
          ref(element) an_element;
        begin Boolean exists;
          add_element(an_element, exists);
          add_element_ok := not exists;
        end;

      Boolean procedure remove_element_ok(key);
          text key;
        begin Boolean no_such;
          remove_element(key, no_such);
          remove_element_ok := not no_such;
        end;

      procedure display;
        begin ref(element) an_element;
          outtext("{");
          an_element :- first_element;
          while an_element =/= none do
            begin
              an_element.display;
              an_element :- next_element;
              if an_element =/= none then outtext(", ");
            end;
          outtext("}");
        end;

      procedure for_each_element(p); procedure p;
        begin ref(element) an_element;
          an_element :- first_element;
          while an_element =/= none do
            begin
              p(an_element);
              an_element :- next_element;
            end;
        end;

    end of basis_set;


!********************************************
!*                        *
!*                 Set                      *
!*                        *
!********************************************;

  basis_set class set;
    begin

      ref(element) head;
      ref(set) tail;

      Boolean procedure is_empty;
        is_empty := head == none;

      Boolean procedure is_member(key); text key;
        if head == none then is_member := false
        else if head.key = key then is_member := true
        else if tail == none then is_member := false
        else is_member := tail.is_member(key);

      integer procedure size;
        size := if head == none then 0 else
            if tail == none then 1
                else 1 + tail.size;

      procedure add_element(an_element, element_exists);
          name element_exists;
          ref(element) an_element; Boolean element_exists;
        if head == none or an_element == none then
          begin head :- an_element; element_exists := false end else
        if head.key = an_element.key then element_exists := true
        else begin
            if tail == none then tail :- new set;
            tail.add_element(an_element, element_exists);
          end;

      procedure remove_add_element(an_element); ref(element) an_element;
        if head == none or else head.key = an_element.key
          then head :- an_element
          else begin
            if tail == none then tail :- new set;
            tail.remove_add_element(an_element);
          end;

      procedure remove_element(key, no_such_element);
          name no_such_element;
      text key; Boolean no_such_element;
        if head == none then no_such_element := true else
        if head.key = key then
          begin
            no_such_element := false;
            if tail == none
              then head :- none
              else begin head :- tail.head; tail :- tail.tail end;
          end else
        if tail == none then no_such_element := true
        else begin
            tail.remove_element(key, no_such_element);
            if tail.is_empty then tail :- none;
          end of remove_element;

      ref(element) procedure find_element(key); text key;
        find_element :-
          if head     == none then none else
          if head.key =  key  then head else
          if tail     == none then none
          else tail.find_element(key);

      ref(set) next_set, kept_next_set;
      ref(stack) next_stack;

      ref(element) procedure first_element;
        begin first_element :- head; push_next; next_set :- tail end;

      ref(element) procedure next_element;
        if next_set == none
        then begin
            next_element :- none;
            pop_next;
          end
        else begin
          next_element :- next_set.head;
          next_set     :- next_set.tail;
        end;

      procedure push_next;
        next_stack.push(next_set);

      procedure pop_next;
        next_set :- if next_stack =/= none then next_stack.pop else none;

      procedure set_current;
        kept_next_set :- next_set;

      procedure reset_current;
        next_set :- kept_next_set;

      next_stack :- new stack;

    end of set;



!********************************************
!*                        *
!*             Ordered_set                  *
!*                        *
!********************************************;

  basis_set class ordered_set;

    begin

      ref(table) element_table;

      Boolean procedure is_empty;
        is_empty := element_table.is_empty;

      integer procedure size;
        size := element_table.size;

      procedure add_element(an_element, element_exists);
          name element_exists;
          ref(element) an_element; Boolean element_exists;
        begin
          if element_table.is_full then
             element_table :- element_table.increase;
          element_table.add_element(an_element, element_exists);
        end;

      procedure remove_add_element(an_element); ref(element) an_element;
        begin
          if element_table.is_full then
             element_table :- element_table.increase;
          element_table.remove_add_element(an_element);
        end;

      procedure remove_element(key, no_such_element);
          name no_such_element; text key; Boolean no_such_element;
        begin
          element_table.remove_element(key, no_such_element);
          if element_table.is_almost_empty then
             element_table :- element_table.decrease;
        end;

      ref(element) procedure find_element(key); text key;
        find_element :- element_table.find_element(key);

      ref(element) procedure first_element;
        first_element :- element_table.first_element;

      ref(element) procedure next_element;
        next_element :- element_table.next_element;

      procedure set_current;
        element_table.set_current;

      procedure reset_current;
        element_table.reset_current;

      element_table :- new table(1);

    end of ordered_set;


!********************************************
!*                        *
!*                Table                     *
!*                        *
!********************************************;

  class table(table_size); integer table_size;

    begin

      ref(element) array the_elements(1 : table_size);

      integer number_of_elements;

      procedure add_element(an_element, element_exists);
          name element_exists;
          ref(element) an_element; Boolean element_exists;
        begin integer index, i;
          index := find_index(an_element.key);
          if index <= number_of_elements and then
           the_elements(index).key = an_element.key then
            element_exists := true
          else begin
              for i := number_of_elements step -1 until index do
                the_elements(i + 1) :- the_elements(i);
              number_of_elements := number_of_elements + 1;
              the_elements(index) :- an_element;
              element_exists := false;
            end;
        end;

      procedure remove_add_element(an_element); ref(element) an_element;
        begin integer index, i;
          index := find_index(an_element.key);
          if index <= number_of_elements and then
           the_elements(index).key = an_element.key then
            the_elements(index) :- an_element
          else begin
              for i := number_of_elements step -1 until index do
                the_elements(i + 1) :- the_elements(i);
              number_of_elements := number_of_elements + 1;
              the_elements(index) :- an_element;
            end;
        end;

      procedure remove_element(key, no_such_element);
          name no_such_element; text key; Boolean no_such_element;
        begin integer index, i;
          index := find_index(key);
          if index <= number_of_elements and then
           the_elements(index).key = key then
            begin
              for i := index + 1 step 1 until number_of_elements do
                the_elements(i - 1) :- the_elements(i);
              number_of_elements := number_of_elements - 1;
              no_such_element := false;
! Endring 12.11.88:    ;
              if index < next_in_table
                then next_in_table := next_in_table - 1;
            end
          else no_such_element := true;
        end;

      ref(element) procedure find_element(key); text key;
        if is_empty then find_element :- none else
        begin integer index;
          index := find_index(key);
          find_element :-
        if index <= number_of_elements and then
           the_elements(index).key = key then the_elements(index)
            else none;
        end;

      integer next_in_table, kept_next_in_table;

      ref(element) procedure first_element;
        begin
          first_element :- element_number(1);
          next_in_table  := 2;
        end;

      ref(element) procedure next_element;
        begin
          next_element :- element_number(next_in_table);
          next_in_table := next_in_table + 1;
        end;

      procedure set_current;
        kept_next_in_table := next_in_table;

      procedure reset_current;
        next_in_table := kept_next_in_table;

      integer procedure size;
        size := number_of_elements;

      Boolean procedure is_empty;
        is_empty := number_of_elements = 0;

      Boolean procedure is_full;
        is_full := number_of_elements = table_size;

      Boolean procedure is_almost_empty;
        is_almost_empty := (number_of_elements < table_size//4
                and table_size > 1);

      ref(element) procedure element_number(number); integer number;
! Rettet 1.april 1992:   ;
        element_number :- if not(1 <= number and number <= number_of_elements)
                          then none
                          else the_elements(number);

      ref(table) procedure increase;
        begin ref(table) aux_table; integer index;
          aux_table :- new table(2 * table_size);
          for index := 1 step 1 until number_of_elements do
            aux_table.the_elements(index) :- the_elements(index);
          aux_table.number_of_elements := number_of_elements;
! Rettet 12.11.88:   ;
          aux_table.next_in_table := next_in_table;
          increase :- aux_table;
        end;

      ref(table) procedure decrease;
        begin ref(table) aux_table; integer index;
          aux_table :- new table(table_size//2);
          for index := 1 step 1 until number_of_elements do
            aux_table.the_elements(index) :- the_elements(index);
          decrease :- aux_table;
          aux_table.number_of_elements := number_of_elements;
! Rettet 12.11.88:   ;
          aux_table.next_in_table := next_in_table;
        end;

      integer procedure find_index(key); text key;
        if number_of_elements = 0 or else
           the_elements(number_of_elements).key < key
        then find_index := number_of_elements + 1
        else begin integer b, t, m;
          b := 0; t := number_of_elements;
          while b + 1 ne t do
            begin
              m := (b + t)//2;
              if the_elements(m).key < key
                then b := m else t := m;
            end;
          find_index := t;
        end;

     number_of_elements := 0;

   end of table;



end of settools;